home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_gnats.idb / usr / freeware / lib / emacs / site-lisp / send-pr.el.z / send-pr.el
Encoding:
Text File  |  1999-04-16  |  26.0 KB  |  745 lines
  1. ;;;; -*-emacs-lisp-*-
  2. ;;;;---------------------------------------------------------------------------
  3. ;;;;    EMACS interface for send-pr (by Heinz G. Seidl, hgs@cygnus.com)
  4. ;;;;    Slightly hacked by Brendan Kehoe (brendan@cygnus.com).
  5. ;;;;
  6. ;;;;    This file is part of the Problem Report Management System (GNATS)
  7. ;;;;    Copyright 1992, 1993 Cygnus Support
  8. ;;;;
  9. ;;;;    This program is free software; you can redistribute it and/or
  10. ;;;;    modify it under the terms of the GNU General Public
  11. ;;;;    License as published by the Free Software Foundation; either
  12. ;;;;    version 2 of the License, or (at your option) any later version.
  13. ;;;;
  14. ;;;;    This program is distributed in the hope that it will be useful,
  15. ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. ;;;;    General Public License for more details.
  18. ;;;;
  19. ;;;;    You should have received a copy of the GNU Library General Public
  20. ;;;;    License along with this program; if not, write to the Free
  21. ;;;;    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22. ;;;;
  23. ;;;;---------------------------------------------------------------------------
  24. ;;;;
  25. ;;;;    This file contains the EMACS interface to the Problem Report Management
  26. ;;;;    System (GNATS):
  27. ;;;;
  28. ;;;;        - The `send-pr' command and the `send-pr-mode' for sending 
  29. ;;;;              Problem Reports (PRs).
  30. ;;;;
  31. ;;;;    For more information about how to send a PR see send-pr(1).
  32. ;;;;
  33. ;;;;---------------------------------------------------------------------------
  34. ;;;;
  35. ;;;;    Configuration: the symbol `DEFAULT-RELEASE' can be replaced by
  36. ;;;;    site/release specific strings during the configuration/installation
  37. ;;;;    process.
  38. ;;;;
  39. ;;;;    Install this file in your EMACS library directory.
  40. ;;;;
  41. ;;;;---------------------------------------------------------------------------
  42.  
  43. (provide 'send-pr)
  44.  
  45. ;;;;---------------------------------------------------------------------------
  46. ;;;; Customization: put the following forms into your default.el file
  47. ;;;; (or into your .emacs)
  48. ;;;;---------------------------------------------------------------------------
  49.  
  50. ;(autoload 'send-pr-mode "send-pr"
  51. ;      "Major mode for sending problem reports." t)
  52.  
  53. ;(autoload 'send-pr "send-pr"
  54. ;            "Command to create and send a problem report." t)
  55.  
  56. ;;;;---------------------------------------------------------------------------
  57. ;;;; End of Customization Section
  58. ;;;;---------------------------------------------------------------------------
  59.  
  60. (autoload 'server-buffer-done "server")
  61. (defvar server-buffer-clients nil)
  62. (defvar mail-self-blind nil)
  63. (defvar mail-default-reply-to nil)
  64.  
  65. (defconst send-pr::version "3.2")
  66.  
  67. (defvar gnats:root "/usr/freeware/lib/gnats/gnats-db"
  68.   "*The top of the tree containing the GNATS database.")
  69.  
  70. ;;;;---------------------------------------------------------------------------
  71. ;;;; hooks
  72. ;;;;---------------------------------------------------------------------------
  73.  
  74. (defvar text-mode-hook nil)   ; we define it here in case it's not defined
  75. (defvar send-pr-mode-hook text-mode-hook "Called when send-pr is invoked.")
  76.  
  77. ;;;;---------------------------------------------------------------------------
  78. ;;;; Domains and default values for (some of) the Problem Report fields;
  79. ;;;; constants and definitions.
  80. ;;;;---------------------------------------------------------------------------
  81.  
  82. (defconst gnats::emacs-19p
  83.   (not (or (and (boundp 'epoch::version) epoch::version)
  84.        (string-lessp emacs-version "19")))
  85.   "Is this emacs v19?")
  86.  
  87. ;;; These may be changed during configuration/installation or by the individual
  88. ;;; user in his/her .emacs file.
  89. ;;;
  90. (defun gnats::get-config (var)
  91.   (let ((shell-file-name "/bin/sh")
  92.     (buf (generate-new-buffer " *GNATS config*"))
  93.     ret)
  94.     (save-excursion
  95.       (set-buffer buf)
  96.       (shell-command (concat ". " gnats:root "/gnats-adm/config; echo $" var )
  97.              t)
  98.       (if (looking-at "/bin/sh:\\|\n")
  99.       (setq ret nil)
  100.     (setq ret (buffer-substring (point-min) (- (point-max) 1)))))
  101.     (kill-buffer buf)
  102.     ret))
  103.  
  104. ;; const because it must match the script's value
  105. (defconst send-pr:datadir (or (gnats::get-config "DATADIR") "/usr/freeware/lib")
  106.   "*Where the `gnats' subdirectory containing category lists lives.")
  107.  
  108. (defvar send-pr::sites nil
  109.   "List of GNATS support sites; computed at runtime.")
  110. (defvar send-pr:default-site
  111.   (or (gnats::get-config "GNATS_SITE") "humu")
  112.   "Default site to send bugs to.")
  113. (defvar send-pr:::site send-pr:default-site
  114.   "The site to which a problem report is currently being submitted, or NIL
  115. if using the default site (buffer local).")
  116.  
  117. (defvar send-pr:::categories nil
  118.   "Buffer local list of available categories, derived at runtime from
  119. send-pr:::site and send-pr::category-alist.")
  120. (defvar send-pr::category-alist nil
  121.   "Alist of GNATS support sites and the categories supported at each; computed
  122. at runtime.")
  123.  
  124. ;;; Ideally we would get all the following values from a central database
  125. ;;; during runtime instead of having them here in the code.
  126. ;;;
  127. (defconst send-pr::fields
  128.   (` (("Category" send-pr::set-categories
  129.        (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum)
  130.       ("Class" (("sw-bug") ("doc-bug") ("change-request") ("support"))
  131.        (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 0)) enum)
  132.       ("Confidential" (("yes") ("no"))
  133.        (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum)
  134.       ("Severity" (("non-critical") ("serious") ("critical"))
  135.        (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum)
  136.       ("Priority" (("low") ("medium") ("high"))
  137.        (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum)
  138.       ("Release" nil
  139.        (, (or (gnats::get-config "DEFAULT_RELEASE") "unknown-1.0"))
  140.        text)
  141.       ("Submitter-Id" nil
  142.        (, (or (gnats::get-config "DEFAULT_SUBMITTER") "humu"))
  143.        text)
  144.       ("Synopsis" nil nil text
  145.        (lambda (a b c) (gnats::set-mail-field "Subject" c)))))
  146.   "AList, keyed on the name of the field, of:
  147. 1) The field name.
  148. 2) The list of completions.  This can be a list, a function to call, or nil.
  149. 3) The default value.
  150. 4) The type of the field.
  151. 5) A sub-function to call when changed.")
  152.  
  153. (defvar gnats::fields nil)
  154.  
  155. (defmacro gnats::push (i l)
  156.   (` (setq (, l) (cons (,@ (list i l))))))
  157.  
  158. (defun send-pr::set-categories (&optional arg)
  159.   "Get the list of categories for the current site out of
  160. send-pr::category-alist if there or from send-pr if not.  With arg, force
  161. update."
  162.   ;;
  163.   (let ((entry (assoc send-pr:::site send-pr::category-alist)))
  164.     (or (and entry (null arg))
  165.     (let ((oldpr (getenv "GNATS_ROOT")) cats)
  166.       (send-pr::set-sites arg)
  167.       (setenv "GNATS_ROOT" gnats:root)
  168.       (setq cats (gnats::get-value-from-shell
  169.               "send-pr" "-CL" send-pr:::site))
  170.       (setenv "GNATS_ROOT" oldpr)
  171.       (if entry (setcdr entry cats)
  172.         (setq entry (cons send-pr:::site cats))
  173.         (gnats::push entry send-pr::category-alist))))
  174.     (setq send-pr:::categories (cdr entry))))
  175.  
  176. (defun send-pr::set-sites (&optional arg)
  177.   "Get the list of sites (by listing the contents of DATADIR/gnats) and assign
  178. it to send-pr::sites.  With arg, force update."
  179.   (or (and (null arg) send-pr::sites)
  180.       (progn
  181.     (setq send-pr::sites nil)
  182.     (mapcar
  183.      (function
  184.       (lambda (file)
  185.         (or (memq t (mapcar (function (lambda (x) (string= x file)))
  186.                 '("." ".." "pr-edit" "pr-addr")))
  187.         (not (file-readable-p file))
  188.         (gnats::push (list (file-name-nondirectory file))
  189.                 send-pr::sites))))
  190.      (directory-files (format "%s/gnats" send-pr:datadir) t))
  191.     (setq send-pr::sites (reverse send-pr::sites)))))
  192.  
  193. (defconst send-pr::pr-buffer-name "*send-pr*"
  194.   "Name of the temporary buffer, where the problem report gets composed.")
  195.  
  196. (defconst send-pr::err-buffer-name "*send-pr-error*"
  197.   "Name of the temporary buffer, where send-pr error messages appear.")
  198.  
  199. (defvar send-pr:::err-buffer nil
  200.   "The error buffer used by the current PR buffer.")
  201.  
  202. (defconst gnats::indent 17 "Indent for formatting the value.")
  203.  
  204. ;;;;---------------------------------------------------------------------------
  205. ;;;; `send-pr' - command for creating and sending of problem reports
  206. ;;;;---------------------------------------------------------------------------
  207.  
  208. (fset 'send-pr 'send-pr:send-pr)
  209. (defun send-pr:send-pr (&optional site)
  210.   "Create a buffer and read in the result of `send-pr -P'.
  211. When finished with editing the problem report use \\[send-pr:submit-pr]
  212. to send the PR with `send-pr -b -f -'."
  213.   ;;
  214.   (interactive
  215.    (if current-prefix-arg
  216.        (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t
  217.                   send-pr:default-site))))
  218.   (or site (setq site send-pr:default-site))
  219.   (let ((buf (get-buffer send-pr::pr-buffer-name)))
  220.     (if (or (not buf)
  221.         (progn (switch-to-buffer buf)
  222.            (cond ((or (not (buffer-modified-p buf))
  223.                   (y-or-n-p "Erase previous problem report? "))
  224.               (erase-buffer) t)
  225.              (t nil))))
  226.     (send-pr::start-up site))))
  227.  
  228. (defun send-pr::start-up (site)
  229.   (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name))
  230.   (setq default-directory (expand-file-name "~/"))
  231.   (auto-save-mode auto-save-default)
  232.   (let ((oldpr (getenv "GNATS_ROOT"))
  233.     (case-fold-search nil))
  234.     (setenv "GNATS_ROOT" gnats:root)
  235.     (shell-command (concat "send-pr -P " site) t)
  236.     (setenv "GNATS_ROOT" oldpr)
  237.     (if (looking-at "send-pr:")
  238.     (cond ((looking-at "send-pr: .* does not have a categories list")
  239.            (setq send-pr::sites nil)
  240.            (error "send-pr: the GNATS site %s does not have a categories list" site))
  241.           (t (error (buffer-substring (point-min) (point-max)))))
  242.       (save-excursion
  243.     ;; Clear cruft inserted by bdamaged .cshrcs
  244.     (re-search-forward "^SEND-PR:")
  245.     (delete-region 1 (match-beginning 0)))))
  246.   (set-buffer-modified-p nil)
  247.   (send-pr:send-pr-mode)
  248.   (setq send-pr:::site site)
  249.   (send-pr::set-categories)
  250.   (if (null send-pr:::categories)
  251.       (progn
  252.     (and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer))
  253.     (kill-buffer nil)
  254.     (message "send-pr: no categories found"))
  255.     (and mail-default-reply-to
  256.      (gnats::set-mail-field "Reply-To" mail-default-reply-to))
  257.     (and mail-self-blind
  258.      (gnats::set-mail-field "BCC" (user-login-name)))
  259.     (mapcar 'send-pr::maybe-change-field send-pr::fields)
  260.     (gnats::position-on-field "Description")
  261.     (message (substitute-command-keys
  262.           "To send the problem report use: \\[send-pr:submit-pr]"))))
  263.  
  264. (fset 'do-send-pr 'send-pr:submit-pr)    ;backward compat
  265. (defun send-pr:submit-pr ()
  266.   "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this
  267. buffer was loaded with emacsclient, in which case save the buffer and exit."
  268.   ;;
  269.   (interactive)
  270.   (cond
  271.    ((and (boundp 'server-buffer-clients)
  272.      server-buffer-clients)
  273.     (let ((buffer (current-buffer))
  274.       (version-control nil) (buffer-backed-up nil))
  275.       (save-buffer buffer)
  276.       (kill-buffer buffer)
  277.       (server-buffer-done buffer)))
  278.    (t
  279.     (or (and send-pr:::err-buffer
  280.          (buffer-name send-pr:::err-buffer))
  281.     (setq send-pr:::err-buffer
  282.           (get-buffer-create send-pr::err-buffer-name)))
  283.     (let ((err-buffer send-pr:::err-buffer) mesg ok)
  284.       (save-excursion (set-buffer err-buffer) (erase-buffer))
  285.       (message "running send-pr...")
  286.       (let ((oldpr (getenv "GNATS_ROOT")))
  287.     (setenv "GNATS_ROOT" gnats:root)
  288.     (call-process-region (point-min) (point-max) "send-pr"
  289.                  nil err-buffer nil send-pr:::site
  290.                  "-b" "-f" "-")
  291.     (setenv "GNATS_ROOT" oldpr))
  292.       (message "running send-pr...done")
  293.       ;; stupidly we cannot check the return value in EMACS 18.57, thus we need
  294.       ;; this kluge to find out whether send-pr succeeded.
  295.       (if (save-excursion
  296.         (set-buffer err-buffer)
  297.         (goto-char (point-min))
  298.         (setq mesg (buffer-substring (point-min) (- (point-max) 1)))
  299.         (search-forward "problem report sent" nil t))
  300.       (progn (message mesg)
  301.          (kill-buffer err-buffer)
  302.          (delete-auto-save-file-if-necessary)
  303.          (set-buffer-modified-p nil)
  304.          (bury-buffer))
  305.     (pop-to-buffer err-buffer))
  306.     ))))
  307.    
  308. ;;;;---------------------------------------------------------------------------
  309. ;;;; send-pr:send-pr-mode mode
  310. ;;;;---------------------------------------------------------------------------
  311.  
  312. (defvar send-pr-mode-map
  313.   (let ((map (make-sparse-keymap)))
  314.     (define-key map "\C-c\C-c" 'send-pr:submit-pr)
  315.     (define-key map "\C-c\C-f" 'gnats:change-field)
  316.     (define-key map "\M-n" 'gnats:next-field)
  317.     (define-key map "\M-p" 'gnats:previous-field)
  318.     (define-key map "\C-\M-f" 'gnats:forward-field)
  319.     (define-key map "\C-\M-b" 'gnats:backward-field)
  320.     map)
  321.   "Keymap for send-pr mode.")
  322.  
  323. (defconst gnats::keyword "^>\\([-a-zA-Z]+\\):")
  324. (defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):")
  325. (defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+")
  326.  
  327. (fset 'send-pr-mode 'send-pr:send-pr-mode)
  328. (defun send-pr:send-pr-mode ()
  329.   "Major mode for submitting problem reports.
  330. For information about the form see gnats(1) and send-pr(1).
  331. Special commands: \\{send-pr-mode-map}
  332. Turning on send-pr-mode calls the value of the variable send-pr-mode-hook,
  333. if it is not nil."
  334.   (interactive)
  335.   (gnats::patch-exec-path)
  336.   (put 'send-pr:send-pr-mode 'mode-class 'special)
  337.   (kill-all-local-variables)
  338.   (setq major-mode 'send-pr:send-pr-mode)
  339.   (setq mode-name "send-pr")
  340.   (use-local-map send-pr-mode-map)
  341.   (set-syntax-table text-mode-syntax-table)
  342.   (setq local-abbrev-table text-mode-abbrev-table)
  343.   (setq buffer-offer-save t)
  344.   (make-local-variable 'send-pr:::site)
  345.   (make-local-variable 'send-pr:::categories)
  346.   (make-local-variable 'send-pr:::err-buffer)
  347.   (make-local-variable 'paragraph-separate)
  348.   (setq paragraph-separate (concat (default-value 'paragraph-separate)
  349.                    "\\|" gnats::keyword "[ \t\n\f]*$"))
  350.   (make-local-variable 'paragraph-start)
  351.   (setq paragraph-start (concat (default-value 'paragraph-start)
  352.                 "\\|" gnats::keyword))
  353.   (run-hooks 'send-pr-mode-hook)
  354.   t)
  355.  
  356. ;;;;---------------------------------------------------------------------------
  357. ;;;; Functions to read and replace field values.
  358. ;;;;---------------------------------------------------------------------------
  359.  
  360. (defun gnats::position-on-field (field)
  361.   (goto-char (point-min))
  362.   (if (not (re-search-forward (concat "^>" field ":") nil t))
  363.       (error "Field `>%s:' not found." field)
  364.     (re-search-forward "[ \t\n\f]*")
  365.     (if (looking-at gnats::keyword)
  366.     (backward-char 1))
  367.     t))
  368.  
  369. (defun gnats::mail-position-on-field (field)
  370.   (let (end
  371.     (case-fold-search t))
  372.     (goto-char (point-min))
  373.     (re-search-forward "^$")
  374.     (setq end (match-beginning 0))
  375.     (goto-char (point-min))
  376.     (if (not (re-search-forward (concat "^" field ":") end 'go-to-end))
  377.     (insert field ": \n")
  378.       (re-search-forward "[ \t\n\f]*"))
  379.     (skip-chars-backward "\n")
  380.     t))
  381.  
  382. (defun gnats::field-contents (field &optional elem move)
  383.   (let (pos)
  384.     (unwind-protect
  385.     (save-excursion
  386.       (if (not (gnats::position-on-field field))
  387.           nil
  388.         (setq pos (point-marker))
  389.         (if (or (looking-at "<.*>$") (eolp))
  390.         t
  391.           (looking-at ".*$")    ; to set match-{beginning,end}
  392.           (gnats::nth-word 
  393.            (buffer-substring (match-beginning 0) (match-end 0))
  394.            elem))))
  395.       (and move pos (goto-char pos)))))
  396.  
  397. (defun gnats::functionp (thing)
  398.   (or (and (symbolp thing) (fboundp thing))
  399.       (and (listp thing) (eq (car thing) 'lambda))))
  400.  
  401. (defun gnats::field-values (field)
  402.   "Return the possible (known) values for field FIELD."
  403.   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
  404.            send-pr::fields))
  405.      (thing (elt (assoc field fields) 1)))
  406.     (cond ((gnats::functionp thing) (funcall thing))
  407.       ((listp thing) thing)
  408.       (t (error "ACK")))))
  409.  
  410. (defun gnats::field-default (field)
  411.   "Return the default value for field FIELD."
  412.   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
  413.            send-pr::fields))
  414.      (thing (elt (assoc field fields) 2)))
  415.     (cond ((stringp thing) thing)
  416.       ((null thing) "")
  417.       ((numberp thing) (car (elt (gnats::field-values field) thing)))
  418.       ((gnats::functionp thing)
  419.        (funcall thing (gnats::field-contents field)))
  420.       ((eq thing t) (gnats::field-contents field))
  421.       (t (error "ACK")))))
  422.  
  423. (defun gnats::field-type (field)
  424.   "Return the type of field FIELD."
  425.   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
  426.            send-pr::fields))
  427.      (thing (elt (assoc field fields) 3)))
  428.     thing))
  429.  
  430. (defun gnats::field-action (field)
  431.   "Return the extra handling function for field FIELD."
  432.   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
  433.            send-pr::fields))
  434.      (thing (elt (assoc field fields) 4)))
  435.     (cond ((null thing) 'ignore)
  436.       ((gnats::functionp thing) thing)
  437.       (t (error "ACK")))))
  438.  
  439. ;;;;---------------------------------------------------------------------------
  440. ;;;; Point movement functions
  441. ;;;;---------------------------------------------------------------------------
  442.  
  443. (or (fboundp 'defsubst) (fset 'defsubst 'defun))
  444.  
  445. (defun send-pr::maybe-change-field (field)
  446.   (setq field (car field))
  447.   (let ((thing (gnats::field-contents field)))
  448.     (and thing (eq t thing)
  449.      (not (eq 'multi-text (gnats::field-type field)))
  450.      (gnats:change-field field))))
  451.     
  452. (defun gnats:change-field (&optional field default)
  453.   "Change the value of the field containing the cursor.  With arg, ask the
  454. user for the field to change.  From a program, the function takes optional
  455. arguments of the field to change and the default value to use."
  456.   (interactive)
  457.   (or field current-prefix-arg (setq field (gnats::current-field)))
  458.   (or field
  459.       (setq field
  460.         (completing-read "Field: "
  461.                  (if (eq major-mode 'gnats:gnats-mode)
  462.                  gnats::fields
  463.                    send-pr::fields)
  464.                  nil t)))
  465.   (gnats::position-on-field field)
  466.   (sit-for 0)
  467.   (let* ((old (gnats::field-contents field))
  468.      new)
  469.     (if (null old)
  470.     (error "ACK")
  471.       (let ((prompt (concat ">" field ": "))
  472.         (domain (gnats::field-values field))
  473.         (type (gnats::field-type field))
  474.         (action (gnats::field-action field)))
  475.     (or default (setq default (gnats::field-default field)))
  476.     (setq new (if (eq type 'enum)
  477.               (completing-read prompt domain nil t 
  478.                        (if gnats::emacs-19p (cons default 0)
  479.                      default))
  480.             (read-string prompt (if gnats::emacs-19p (cons default 1)
  481.                       default))))
  482.     (gnats::set-field field new)
  483.     (funcall action field old new)
  484.     new))))
  485.  
  486. (defun gnats::set-field (field value)
  487.   (save-excursion
  488.     (gnats::position-on-field field)
  489.     (delete-horizontal-space)
  490.     (looking-at ".*$")
  491.     (replace-match
  492.      (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t)))
  493.  
  494. (defun gnats::set-mail-field (field value)
  495.   (save-excursion
  496.     (gnats::mail-position-on-field field)
  497.     (delete-horizontal-space)
  498.     (looking-at ".*$")
  499.     (replace-match (concat " " value) t)))
  500.   
  501. (defun gnats::before-keyword (&optional where)
  502.   "Returns t if point is in some white space before a keyword.
  503. If where is nil, then point is not changed; if where is t then point is moved
  504. to the beginning of the keyword, otherwise it is moved to the beginning
  505. of the white space it was in."
  506.   ;;
  507.   (if (looking-at gnats::before-keyword)
  508.       (prog1 t
  509.     (cond  ((eq where t)
  510.         (re-search-forward "^>") (backward-char))
  511.            ((not (eq where nil))
  512.         (re-search-backward "[^ \t\n\f]") (forward-char))))
  513.        nil))
  514.  
  515. (defun gnats::after-keyword (&optional where)
  516.   "Returns t if point is in some white space after a keyword.
  517. If where is nil, then point is not changed; if where is t then point is moved
  518. to the beginning of the keyword, otherwise it is moved to the end of the white
  519. space it was in."
  520.   ;;
  521.   (if (gnats::looking-after gnats::after-keyword)
  522.       (prog1 t
  523.     (cond  ((eq where t)
  524.         (re-search-backward "^>"))
  525.            ((not (eq where nil))
  526.         (re-search-forward "[^ \t\n\f]") (backward-char))))
  527.        nil))
  528.  
  529. (defun gnats::in-keyword (&optional where)
  530.   "Returns t if point is within a keyword.
  531. If where is nil, then point is not changed; if where is t then point is moved
  532. to the beginning of the keyword."
  533.   ;;
  534.   (let ((old-point (point-marker)))
  535.     (beginning-of-line)
  536.     (cond ((and (looking-at gnats::keyword)
  537.            (< old-point (match-end 0)))
  538.        (prog1 t
  539.          (if (eq where t) 
  540.          t
  541.            (goto-char old-point))))
  542.       (t (goto-char old-point)
  543.          nil))))
  544.  
  545. (defun gnats::forward-bofield ()
  546.   "Moves point to the beginning of a field. Assumes that point is in the
  547. keyword." 
  548.   ;;
  549.   (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-)
  550.       (backward-char)
  551.     t))
  552.  
  553. (defun gnats::backward-eofield ()
  554.   "Moves point to the end of a field. Assumes point is in the keyword."
  555.   ;;
  556.   (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-)
  557.       (forward-char)
  558.     t))
  559.  
  560. (defun gnats::forward-eofield ()
  561.   "Moves point to the end of a field. Assumes that point is in the field." 
  562.   ;;
  563.   ;; look for the next field
  564.   (if (re-search-forward gnats::keyword (point-max) '-) 
  565.       (progn (beginning-of-line) (gnats::backward-eofield))
  566.   (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-)
  567.   (forward-char)))
  568.  
  569. (defun gnats::backward-bofield ()
  570.   "Moves point to the beginning of a field. Assumes that point is in the
  571. field." 
  572.   ;;
  573.   ;;look for previous field
  574.   (if (re-search-backward gnats::keyword (point-min) '-)
  575.       (gnats::forward-bofield)
  576.     t))
  577.  
  578.  
  579. (defun gnats:forward-field ()
  580.   "Move point forward to the end of the field or to the beginning of the next
  581. field."
  582.   ;;
  583.   (interactive)
  584.   (if (or (gnats::before-keyword t) (gnats::in-keyword t)
  585.       (gnats::after-keyword t))
  586.     (gnats::forward-bofield)
  587.     (gnats::forward-eofield)))
  588.  
  589. (defun gnats:backward-field ()
  590.   "Move point backward to the beginning/end of a field."
  591.   ;;
  592.   (interactive)
  593.   (backward-char)
  594.   (if (or (gnats::before-keyword t) (gnats::in-keyword t)
  595.       (gnats::after-keyword t))
  596.       (gnats::backward-eofield)
  597.     (gnats::backward-bofield)))
  598.  
  599. (defun gnats:next-field ()
  600.   "Move point to the beginning of the next field."
  601.   ;;
  602.   (interactive)
  603.   (if (or (gnats::before-keyword t) (gnats::in-keyword t)
  604.       (gnats::after-keyword t))
  605.       (gnats::forward-bofield)
  606.     (if (re-search-forward gnats::keyword (point-max) '-)
  607.     (gnats::forward-bofield)
  608.       t)))
  609.  
  610. (defun gnats:previous-field ()
  611.   "Move point to the beginning of the previous field."
  612.   ;;
  613.   (interactive)
  614.   (backward-char)
  615.   (if (or (gnats::after-keyword t) (gnats::in-keyword t)
  616.       (gnats::before-keyword t))
  617.       (progn (re-search-backward gnats::keyword (point-min) '-)
  618.          (gnats::forward-bofield))
  619.     (gnats::backward-bofield)))
  620.  
  621. (defun gnats:beginning-of-field ()
  622.   "Move point to the beginning of the current field."
  623.   (interactive)
  624.   (cond ((gnats::in-keyword t)
  625.      (gnats::forward-bofield))
  626.     ((gnats::after-keyword 0))
  627.     (t
  628.      (gnats::backward-bofield))))
  629.  
  630. (defun gnats::current-field ()
  631.   (save-excursion
  632.     (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t))
  633.            (looking-at gnats::keyword))
  634.           ((re-search-backward gnats::keyword nil t)))
  635.     (buffer-substring (match-beginning 1) (match-end 1))
  636.       nil)))
  637.  
  638. ;;;;---------------------------------------------------------------------------
  639. ;;;; Support functions
  640. ;;;;---------------------------------------------------------------------------
  641.  
  642. (defun gnats::looking-after (regex)
  643.   "Returns t if point is after regex."
  644.   ;;
  645.   (let* ((old-point (point))
  646.      (start (if (eobp)
  647.            old-point
  648.          (forward-char) (point))))
  649.     (cond ((re-search-backward regex (point-min) t)
  650.        (goto-char old-point)
  651.        (cond ((eq (match-end 0) start)
  652.           t))))))
  653.  
  654. (defun gnats::nth-word (string &optional elem)
  655.   "Returns the elem-th word of the string.
  656. If elem is nil, then the first wort is returned, if elem is 0 then
  657. the whole string is returned."
  658.    ;;
  659.   (if (integerp elem)
  660.       (cond ((eq elem 0) string)
  661.         ((eq elem 1) (gnats::first-word string))
  662.         ((equal string "") "")
  663.         ((>= elem 2) 
  664.          (let ((i 0) (value ""))
  665.            (setq string        ; strip leading blanks
  666.              (substring string (or (string-match "[^ \t]" string) 0)))
  667.            (while (< i elem)
  668.          (setq value 
  669.                (substring string 0 
  670.                   (string-match "[ \t]*$\\|[ \t]+" string)))
  671.          (setq string 
  672.                (substring string (match-end 0)))
  673.          (setq i (+ i 1)))
  674.            value)))
  675.     (gnats::first-word string)))
  676.  
  677. (defun gnats::first-word (string)
  678.   (setq string 
  679.     (substring string (or (string-match "[^ \t]" string) 0)))
  680.   (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string)))
  681.  
  682. ;;;;---------------------------------------------------------------------------
  683.  
  684. (defun gnats::patch-exec-path ()
  685.   ;;
  686.   "Replaces `//' by `/' in `exec-path'."
  687.   ;;
  688.   ;(make-local-variable 'exec-path)
  689.   (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*"))
  690.     (ret))
  691.     (setq exec-path (save-excursion (set-buffer err-buffer)
  692.                     (prin1 exec-path err-buffer)
  693.                     (goto-char (point-min))
  694.                     (replace-string "//" "/")
  695.                     (goto-char (point-min))
  696.                     (setq ret (read err-buffer))
  697.                     (kill-buffer err-buffer)
  698.                     ret
  699.                     ))))
  700.  
  701. (defun gnats::get-value-from-shell (&rest command)
  702.   "Execute shell command to get a list of valid values for `variable'."
  703.   ;;
  704.   (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*")))
  705.     (save-excursion
  706.       (set-buffer err-buffer)
  707.       (unwind-protect
  708.       (condition-case var
  709.           (progn
  710.         (apply 'call-process
  711.                (car command) nil err-buffer nil (cdr command))
  712.         (goto-char (point-min))
  713.         (if (looking-at "[-a-z]+: ")
  714.             (error (buffer-substring (point-min) (point-max))))
  715.         (read err-buffer))
  716.         (error nil))
  717.     (kill-buffer err-buffer)))))
  718.  
  719. (or (fboundp 'setenv)
  720.     (defun setenv (variable &optional value)
  721.       "Set the value of the environment variable named VARIABLE to VALUE.
  722. VARIABLE should be a string.  VALUE is optional; if not provided or is
  723. `nil', the environment variable VARIABLE will be removed.  
  724. This function works by modifying `process-environment'."
  725.       (interactive "sSet environment variable: \nsSet %s to value: ")
  726.       (if (string-match "=" variable)
  727.       (error "Environment variable name `%s' contains `='" variable)
  728.     (let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
  729.           (case-fold-search nil)
  730.           (scan process-environment))
  731.       (while scan
  732.         (cond
  733.          ((string-match pattern (car scan))
  734.           (if (eq nil value)
  735.           (setq process-environment (delq (car scan)
  736.                           process-environment))
  737.         (setcar scan (concat variable "=" value)))
  738.           (setq scan nil))
  739.          ((null (setq scan (cdr scan)))
  740.           (setq process-environment
  741.             (cons (concat variable "=" value)
  742.               process-environment)))))))))
  743.  
  744. ;;;; end of send-pr.el
  745.